home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
By the Book
/
Mac Pascal Primer, 4.0
/
Chap 7, ShowClip ƒ
/
ShowClip.p
next >
Wrap
Text File
|
1990-06-22
|
2KB
|
102 lines
program ShowClip;
const
BASE_RES_ID = 400;
ERROR_ALERT_ID = BASE_RES_ID + 1;
NO_WIND = BASE_RES_ID;
EMPTY_SCRAP = BASE_RES_ID + 1;
NIL_STRING = '';
HOPELESSLY_FATAL_ERROR = 'Game over, man!';
var
gClipWindow: WindowPtr;
{--------------------------------> ErrorHandler <---}
procedure ErrorHandler (stringNum: INTEGER);
var
errorStringH: StringHandle;
dummy: INTEGER;
begin
errorStringH := GetString(stringNum);
if errorStringH = nil then
ParamText(HOPELESSLY_FATAL_ERROR, NIL_STRING, NIL_STRING, NIL_STRING)
else
ParamText(errorStringH^^, NIL_STRING, NIL_STRING, NIL_STRING);
dummy := StopAlert(ERROR_ALERT_ID, nil);
ExitToShell;
end;
{--------------------------------> CenterPict <---}
procedure CenterPict (thePicture: PicHandle; var myRect: Rect);
var
windRect, pictureRect: Rect;
begin
windRect := myRect;
pictureRect := thePicture^^.picFrame;
myRect.top := (windRect.bottom - windRect.top - (pictureRect.bottom - pictureRect.top)) div 2 + windRect.top;
myRect.bottom := myRect.top + (pictureRect.bottom - pictureRect.top);
myRect.left := (windRect.right - windRect.left - (pictureRect.right - pictureRect.left)) div 2 + windRect.left;
myRect.right := myRect.left + (pictureRect.right - pictureRect.left);
end;
{--------------------------------> MainLoop <---}
procedure MainLoop;
var
myRect: Rect;
clipHandle: Handle;
length, offset: LONGINT;
begin
clipHandle := NewHandle(0);
length := GetScrap(clipHandle, 'TEXT', offset);
if length < 0 then
begin
length := GetScrap(clipHandle, 'PICT', offset);
if length < 0 then
ErrorHandler(EMPTY_SCRAP)
else
begin
myRect := gClipWindow^.portRect;
CenterPict(PicHandle(clipHandle), myRect);
DrawPicture(PicHandle(clipHandle), myRect);
end;
end
else
begin
HLock(clipHandle);
TextBox(Ptr(clipHandle^), length, thePort^.portRect, teJustLeft);
HUnlock(clipHandle);
end;
while not Button do
begin
end;
end;
{--------------------------------> WindowInit <---}
procedure WindowInit;
begin
gClipWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
if gClipWindow = nil then
ErrorHandler(NO_WIND);
ShowWindow(gClipWindow);
SetPort(gClipWindow);
end;
{--------------------------------> ShowClip <---}
begin
WindowInit;
MainLoop;
end.